'**********  M a ß s t a b  x  **********
    '*                                      *
    '*  © Oktober 1988 by Michael Gottwald  *
    '*                                      *
    '****************************************
    
 ON ERROR GOTO Fehler
 
Start: PALETTE 0,0.25,0.25,0.25:PALETTE 2,0,0.7,0:PALETTE 3,0,0,1:COLOR 1,3
       CIRCLE (320,12),160,3,,,0.07:PAINT (250,12),3:LOCATE 2,32:m$="Km"
       PRINT" M A ß S T A B  X ":LOCATE 5,2:COLOR 2,0:b=0
       PRINT"Dieses Programm berechnet aus dem den eingegebenen Maßen - das";
       PRINT" können Ent-":PRINT" fernungen, Durchmesser, Längen ,Breiten";
       PRINT" oder Höhen sein - ein zweites Maß-":PRINT" system, in dem ";
       PRINT"die Maße maßstabsgerecht verkleinert oder vergrößert werden."
       PRINT" Daraus wird dann eine Tabelle erstellt.":PRINT
       PRINT" Hierzu ein Beispiel: Sie haben die Entfernungen und Durchme";
       PRINT"sser der Planeten":PRINT" voneinander und der Sonne eingegeben."
       PRINT" Nun sagen Sie, die Entfernung Erde-Mond (ø 384403 Km) soll nu";
       PRINT"n auf 100 Meter":PRINT" zusammenschrumpfen. Wie weit wäre dann";
       PRINT" die Sonne von unserer Erde entfernt ?":PRINT" (ø 149597000 Km";
       PRINT") - knapp 39 Km !":PRINT:PRINT" Der Sinn des Programms ist es ";
       PRINT"- basierend auf einem Maßstab (z.B. 'Erde-Mond"
       PRINT" = 0.1 Km) eine Tabelle zu erstellen. Damit können große Ent";
       PRINT"fernungen ver-":PRINT" kleinert werden und in unsere Vorstell";
       PRINT"ungsswelt gerückt werden. Das ist":PRINT" sinnvoll, wenn man";
       PRINT" beispielsweise die Entfernungen in unserem Sonnensystem"
       PRINT" verständlich machen will.":LINE (8,167)-(639,176),2,bf
       LOCATE 22,27:COLOR 1,2:PRINT"© 1988 by Michael Gottwald":LOCATE 20,63
       COLOR 0,2:PRINT" Taste drücken ":WHILE INKEY$="":WEND:COLOR 1,0:CLS
       LOCATE 2,2:PRINT"Wieviel Datensätze wollen Sie speichern ? (mind. 21";
       PRINT", da 21 im Programm vor-":PRINT" gespeichert sind !)":PRINT
       PRINT" (Jeweils [Name,Zahl] = 1 Datensatz !)":COLOR 2,0:LOCATE 10,1
Anzahl: INPUT " Anzahl der Datensätze: ",ag:IF ag<21 THEN BEEP:GOTO Anzahl
        ag=ag-1:a=20:DIM d(ag*2+1),d$(ag):FOR i=0 TO 20:READ d$(i),d(i)
        IF LEFT$(d$(i),1)<>"ø" THEN d(i)=d(i)*1000000
        :NEXT 
Menue:  CLS:COLOR 1,3:FOR i=16 TO 617 STEP 8:LINE (i,0)-(i,24),3:NEXT
        FOR i=0 TO 24 STEP 4:LINE (16,i)-(617,i),3:NEXT:LOCATE 2,35
        PRINT" M E N Ü ":LINE (16,40)-(617,160),1,b:PAINT (20,60),3,1
        LOCATE 7,21:COLOR 1,3:PRINT"<F1>   Vorhandene Datei löschen"
        LOCATE 9,21:PRINT"<F2>   Datei von Diskette laden":LOCATE 11,21
        PRINT"<F3>   Datei auf Diskette speichern":LOCATE 13,21
        PRINT"<F4>   Tabelle berechnen":LOCATE 15,21
        PRINT"<F5>   Tabelle zeigen":LOCATE 17,21:PRINT"<F6>   Tabelle aus";
        PRINT"drucken":LOCATE 19,21:PRINT"<F7>   Daten eingeben":LOCATE 22,20
        COLOR 1,3:PRINT" <ESC> beendet das Programm... " 
Tasten:  k$=INKEY$:IF k$=CHR$(129) THEN Loeschen
         IF k$=CHR$(130) THEN Laden
         IF k$=CHR$(131) THEN Speichern
         IF k$=CHR$(132) THEN Berechnen
         IF k$=CHR$(133) THEN Zeigen
         IF k$=CHR$(134) THEN Drucken
         IF k$=CHR$(135) THEN Eingeben
         IF k$=CHR$(27) THEN END
        GOTO Tasten
Loeschen: a$="D A T E N  L Ö S C H E N":GOSUB Titel:LOCATE 6,20:COLOR 1,0
          PRINT"Wollen Sie wirklich alle Daten löschen ?":LOCATE 8,20
          PRINT"Drücken Sie die ";:COLOR 0,1:PRINT" J ";:COLOR 1,0
          PRINT" - oder ";:COLOR 0,1:PRINT" N ";:COLOR 1,0:PRINT" - Taste !"
JoderN:   k$=INKEY$:IF k$="j"THEN LDaten
          IF k$="n" THEN Menue
         GOTO JoderN
LDaten:   d(0)=0:d$(0)="":a=0:COLOR 2,0:PRINT:PRINT"Daten gelöscht !":PRINT
          m$="":WHILE m$="":INPUT"Neue Maßeinheit ? (Km,m,cm,mm ...)";m$:WEND          
          PRINT:GOTO Taste
Laden:    a$="D A T E N  L A D E N":GOSUB Titel:LOCATE 6,1:COLOR 1,0
Dname:    INPUT" Bitte geben Sie den Dateinamen an: ",n$:IF n$="" THEN Dname
          OPEN "i",#1,n$:INPUT #1,a,m$:IF a>ag THEN Ueberlauf
          FOR i=0 TO a:INPUT #1,d$(i),d(i):NEXT:CLOSE #1
Taste:    COLOR 2,0:PRINT:PRINT SPC(18);" Bitte drücken Sie eine ";
          PRINT"beliebige Taste...":WHILE INKEY$="":WEND:GOTO Menue 
Ueberlauf: PRINT:PRINT" Die Datei ist größer als der reservierte Speicher !"
           PRINT:PRINT" Starten Sie das Programm neu und reservieren Sie ";
           PRINT"bitte"a+1"Datensätze !":PRINT:PRINT"Bis bald...":END
Speichern:a$="D A T E N  S P E I C H E R N":GOSUB Titel:LOCATE 6,1:COLOR 1,0
Sname:    INPUT" Bitte geben Sie den Dateiname an: ",n$:IF n$="" THEN Sname
          OPEN n$ FOR OUTPUT AS #1:WRITE #1,a,m$:FOR i=0 TO a 
          WRITE #1,d$(i),d(i):NEXT:CLOSE #1:GOTO Taste
Berechnen:a$="B A S I S M A ß  B E R E C H N E N":GOSUB Titel:LOCATE 5,2
          PRINT"Bitte scrollen Sie die Daten mit den Cursortasten, bis der ";
          PRINT"gewünschte Daten-":PRINT" satz im grünen Feld ist ! Mit <EN";
          PRINT"TER> wird der Datensatz ausgewählt.":n=0
Scrollen: p=9:i=n:LINE (8,71)-(617,97),3,bf:WHILE p<12 AND i<=a:p=p+1
          LOCATE p,3:IF p=10 THEN COLOR 1,2
          PRINT d$(i),d(i);" ";m$:COLOR 1,3:i=i+1:WEND
Cursor:   IF PEEK(12577793)=103 AND n>0 THEN n=n-1:GOTO Scrollen
          IF PEEK(12577793)=101 AND n<a THEN n=n+1:GOTO Scrollen
          IF PEEK(12577793)=119 THEN Nehmen
         GOTO Cursor
Nehmen:   COLOR 1,0:CLS:LOCATE 2,2:PRINT d$(n);" war bisher ";d(n)m$:PRINT
          b=n:PRINT" Geben Sie bitte nun das neue Maß ein:":COLOR 2,0:PRINT
          e=0:WHILE e=0:INPUT"-> ",e:WEND:FOR i=0 TO a:d(ag+1+i)=d(i)/d(n)*e
          NEXT:GOTO Taste  
Zeigen:  a$="Blättern mit den Cursortasten...      <ENTER> = ins Menü"
         GOSUB Titel:LOCATE 4,15
         COLOR 1,3:LINE (0,23)-(303,176),3,bf:LINE (304,23)-(463,176),2,bf
         LINE (464,23)-(617,176),1,bf:PRINT"Kommentar":LOCATE 4,42:COLOR 1,2
         PRINT"Bisheriges Maß":LOCATE 4,64:COLOR 3,1:PRINT"Neues Maß" 
         LINE (0,33)-(617,33),0:n=0
Tabelle: LINE (0,34)-(303,176),3,bf:LINE (304,34)-(463,176),2,bf:i=n:p=5
         LINE (464,34)-(617,176),1,bf:WHILE p<22 AND i<=a:p=p+1:LOCATE p,1
         COLOR 1,3:PRINT USING"\                                    \";d$(i) 
         COLOR 1,2:LOCATE p,39
         v$=MID$(STR$(d(i)),2)+" "+m$:PRINT USING"\                  \";v$
         COLOR 3,1:LOCATE p,59             
       v$=MID$(STR$(d(ag+1+i)),2)+" "+m$:PRINT USING"\                  \";v$
         i=i+1:WEND
Blaett:  IF PEEK(12577793)=119 THEN COLOR 1,0:GOTO Menue
         IF PEEK(12577793)=103 AND n-8>=0 THEN n=n-8:GOTO Tabelle
         IF PEEK(12577793)=101 AND n+8<=a+1 THEN n=n+8:GOTO Tabelle         
        GOTO Blaett  
Eingeben: a$="D A T E N  E I N G E B E N":GOSUB Titel:LOCATE 5,2
          PRINT"Wollen Sie...":LOCATE 7,16:COLOR 1,3:PRINT" F1 ";:COLOR 1,0
          PRINT" die neuen Daten anhängen,":LOCATE 9,16:COLOR 1,3 
          PRINT" F2 ";:COLOR 1,0:PRINT" eine neue Datei anfangen," 
          LOCATE 11,16:COLOR 1,3:PRINT" F3 ";:COLOR 1,0
          PRINT" oder lieber wieder ins Menü zurück..."
Auswahl:  k$=INKEY$:IF k$=CHR$(129) THEN Anhaengen
          IF k$=CHR$(130) THEN a=-1:GOTO Anhaengen
          IF k$=CHR$(131) THEN Menue
         GOTO Auswahl
Anhaengen: a$="D A T E N  A N H Ä N G E N":GOSUB Titel:LOCATE 5,3:w$=""
           PRINT"Mit 'ende' wird die Eingabe beendet !":COLOR 2,0:PRINT
           IF a=ag THEN PRINT" Nichts mehr frei !":GOTO Taste 
           WHILE w$<>"ende" AND a<ag:PRINT" Es sind noch"ag-a"Datensät";
           PRINT"ze frei...":PRINT:a=a+1:INPUT"Kommentar: ",w$
           PRINT"Maß in "m$;:INPUT": ",d(a):d$(a)=w$:WEND
           IF w$="ende" THEN a=a-1:GOTO Taste
           PRINT" Datenspeicher voll !":GOTO Taste                                
Drucken:  a$="T A B E L L E  A U S D R U C K E N":GOSUB Titel:LOCATE 8,15
          PRINT"Bitte Drucker vorbereiten, dann <ENTER> drücken !"
          WHILE INKEY$<>CHR$(13):WEND:OPEN "par:"FOR OUTPUT AS #2 
          PRINT#2,SPC(16);CHR$(27);CHR$(14);"*** MASSUMRECHNUNG ***"
          PRINT#2,"":PRINT#2,"Basismass:";STR$(d(b));" ";m$;" wird zu";
          PRINT#2,STR$(d(b+ag+1));" ";m$:PRINT#2,"" 
          PRINT#2,CHR$(27);CHR$(14);:PRINT#2,"Kommentar       Altes Mass ";
          PRINT#2," Neues Mass  ":CLOSE #2:FOR i=0 TO a:w$=d$(i)
          IF LEN(w$)>=38 THEN w$=LEFT$(w$,38) :ELSE w$=w$+SPACE$(38-LEN(w$)) 
          LPRINT w$;:w$=STR$(d(i))+" "+m$ 
          IF LEN(w$)>=21 THEN w$=LEFT$(w$,21) :ELSE w$=w$+SPACE$(21-LEN(w$))
          LPRINT w$;:w$=STR$(d(i+a+1))+" "+m$
          IF LEN(w$)>=21 THEN w$=LEFT$(w$,21) :ELSE w$=w$+SPACE$(21-LEN(w$))
          LPRINT w$;:NEXT:LOCATE 11,21:PRINT"Datenübertragung zum Drucker ";
          PRINT"beendet !":PRINT:GOTO Taste
Titel:   COLOR 1,0:CLS:COLOR 3,2:CIRCLE (32,12),16,1,1.57,4.71
         CIRCLE (600,12),16,1,4.71,1.57:LINE (32,4)-(600,4),1
         LINE (32,20)-(600,20),1:PAINT (32,12),2,1:p=(640-LEN(a$)*8)/2
         LOCATE 2:PRINT PTAB(p);a$:COLOR 1,0:RETURN           
Fehler:  a$="F E H L E R !":GOSUB Titel:COLOR 1,0:IF ERR=53 THEN Disk
         PRINT:PRINT" Fehlernummer =";ERR:GOTO Zurueck
Disk:    LOCATE 8,5:PRINT"He Sie ! Entweder war das der falsche Name oder ";
         PRINT"die Datei befindet sich":PRINT"    nicht auf dieser Diskette !"
Zurueck: LOCATE 11,20:PRINT"Mit einer beliebigen Taste geht's weiter..."        
         WHILE INKEY$="":WEND:RESUME Menue

Daten:        'Entfernungen in Millionen Kilometer !   = Durchmesser !
       DATA "ø Sonne",1392530,"Entf. Sonne-Merkur",57.9,"ø Merkur",4878
       DATA "Entf. Sonne-Venus",108.2,"ø Venus",12104,"Entf. Sonne-Erde"
       DATA 149.6,"ø Erde",12756,"Entf. Sonne-Mars",227.9,"ø Mars",6794
       DATA "Entf. Sonne-Jupiter",778.3,"ø Jupiter",142800
       DATA "Entf. Sonne-Saturn",1427,"ø Saturn",120000,"Entf. Sonne-Uranus"
       DATA 2870,"ø Uranus",51800,"Entf. Sonne-Neptun",4496.7,"ø Neptun"
       DATA 50220,"Entf. Sonne-Pluto",5899,"ø Pluto (?)",3000,"Entf. Erde-Mond"
       DATA .384403,"ø Mond",3444